MacFormat 1995 January/macformat-020.iso/Shareware City/Applications/Alpha.5.96 folder/Tcl/SystemCode/filesets.tcl

Text File | 1994-09-18 | 5.3 KB | 175 lines | [TEXT/ALFA]

#===============================================================================================
# Create new filesets either by the "Utils:Add Fileset..." menu item. These
# filesets can be made permanent by "Utils:Dump Fileset..."ing the fileset
# to immediately below.
#
# Alpha calls two fileset-related routines, 'getCurrFileSet', and
# 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
# on occasion, but this isn't critical.
#===============================================================================================

#===========================================================================
# The filesets.
#===========================================================================

# Build some filesets on the fly.
catch {unset fileSets}
catch {unset currFileSet}
catch {set fileSets(HomeDir) [glob -t TEXT "$HOME:*"]}
catch {set fileSets(Help) [glob -t TEXT   "$HOME:Help:*"]}
catch {set fileSets(System) [glob -t TEXT "$HOME:Tcl:SystemCode:*.tcl"]}
catch {set fileSets(User) [glob -t TEXT   "$HOME:Tcl:UserCode:*.tcl"]}

# Default curr fileset is the first one. Can be changed in 'userStartup.tcl'.
set currFileSet [lindex [array names fileSets] 0]


#===========================================================================
# The support routines.
#===========================================================================
# Called from Alpha to get list of files for current file set.
proc getCurrFileSet {} {
    global fileSets
    global currFileSet
    return $fileSets($currFileSet)
}
# Called from Alpha to get names. The first name returned is taken to
# be the current fileset.
proc getFileSetNames {} {
    global fileSets
    global currFileSet
    set ind [lsearch [array names fileSets] $currFileSet]
    if {$ind < 0} {set ind 0}
    return [linsert [lsort [lreplace [array names fileSets] $ind $ind]] 0 $currFileSet]
}


# Keep 'sets' menu up to date.
trace vdelete currFileSet w shadowCurrFileSet
trace variable currFileSet w shadowCurrFileSet
proc shadowCurrFileSet {nm1 nm2 op} {
    global fileSets
    global currFileSet
    foreach name [array names fileSets] {
        if {$name == $currFileSet} {
            markMenuItem -m choose $name on
        } else {
            markMenuItem -m choose $name off
        }
    }
    return $currFileSet
}

# Called in response to user changing filesets from the fileset menu.
proc changeFileSet {menu item} {
    global currFileSet

    markMenuItem -m choose $currFileSet off
    set currFileSet $item
    markMenuItem -m choose $currFileSet on
}


#===========================================================================
# Add fileset.
#===========================================================================
proc createFileset {} {
    global fileSets
    global currFileSet

    set name [getline "New fileset name:" ""]
    if {![string length $name]} return

    set dir [string trim [get_directory] ":"]
    if {![string length $dir]} return

    set filePat [getline "File pattern:" "*"]
    if {![string length $filePat]} return

    set "fileSets($name)" [glob -t TEXT "$dir:$filePat"]
    menu -n choose -m -p changeFileSet [lsort [array names fileSets]]
    set currFileSet $name

    if {[askyesno "Save new fileset?"] == "yes"} {
        addUserLine "set \"fileSets($name)\" \[glob -t TEXT  \{$dir:$filePat\}\]"
    }
    makeFilesetMenu
}


#===========================================================================
# Dump fileset to current window. If you dump at the end of this file,
# the fileset will be reloaded the next time you run Alpha.
#===========================================================================
proc dumpFileset {} {
    global fileSets
    global currFileSet
    if {![catch {prompt "Fileset name:" $currFileSet} name]} {
        insertText "set \"fileSets($name)\" \{\r"
        foreach file "$fileSets($name)" {
            insertText "\t\"$file\"\r"
        }
        insertText "\}\r"
    }
}



#================================================================================
# Edit a file from a fileset via list dialogs (no mousing around).
#================================================================================
proc editFile {} {
    global fileSets

    set fset [listpick -p {Fileset?} [lsort -ignore [array names fileSets]]]
    if {[string length $fset]} {
        foreach f $fileSets($fset) {
            lappend disp [file tail $f]
        }
        set res [listpick -p {File?} [lsort -ignore $disp]]
        if {[string length $res]} {
            set ind [lsearch $fileSets($fset) \*$res]
            edit [lindex $fileSets($fset) $ind]
        }
    }
}


#================================================================================
# Create a heirarchical fileset menu that allows you
# to open any file in any fileset.
#
# Doesn't bother trying to specialcase names or pathnames that have
# non-alphanumeric characters in them.

proc filesetProc {menu item} {
    global fileSets
    if {[set match [lsearch $fileSets($menu) *:$item]] >= 0} {
        edit [lindex $fileSets($menu) $match]
    }
}

proc makeFilesetMenu {} {
    global fileSets fsetMenuName
    foreach f [lsort [array names fileSets]] {
        if {$f == "Help"} continue
        set menu {}
        foreach m $fileSets($f) {
            lappend menu [file tail $m]
        }
        lappend sets [list menu -m -n $f -p filesetProc [lsort -i $menu]]
    }
    menu -m -n $fsetMenuName -p filesetProc [concat $sets {"(-" {menu -n Utilities {}}}]

    menu -n "Utilities" {
        {menu -n choose -p changeFileSet {}}
        "createFileset…"
        "createThinkFileset…"
        "dumpFileset…"
        "/'editFile"
        "(-"
        "findTag"
        "createTagFile"}
}